home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 21
/
Cream of the Crop 21 (Terry Blount) (October 1996).iso
/
database
/
tickle15.zip
/
REPORT.PPS
< prev
next >
Wrap
Text File
|
1996-08-02
|
6KB
|
171 lines
STRING dbfields(49), usr_name, hold, reg_code, user_input
LONG record_num, value, total_records
INT x, count, y
FLOAT files_per_user, total_users, total_files, total_users_wfiles
FLOAT total_users_wofiles
:MAIN_BEGIN
GOSUB OPEN_DATABASE
IF (DERR(0)) THEN
NEWLINE
PRINTLN "Cannot open TICKLE.DBF (DataBase) - Aborting"
NEWLINE
LOG "Cannot open TICKLE.DBF (DataBase) - Aborting", FALSE
WAIT
END
END IF
STARTDISP FNS
FAPPEND 1, PPEPATH() + "TKLREPRT.LOG", O_RW, S_DN
FPUTLN 1, "───────────────────────────────────────────────────-"
FPUTLN 1, "REPORT.PPE - A 'Tickle File' Database Report Program"
FPUTLN 1, ""
FPUTLN 1, " Written by: Dan Shore - SysOp"
FPUTLN 1, " The Shoreline BBS"
FPUTLN 1, ""
FPUTLN 1, " Copyright 1995,1996 (c) - Dan Shore"
FPUTLN 1, ""
total_records = DRECCOUNT(0)
WHILE (record_num < total_records) DO
INC record_num
DGO 0, record_num
IF (DERR(0)) BREAK
hold = DGET (0, DNAME(0,1))
hold = TRIM(hold, " ")
hold = MIXED(hold)
PRINTLN "Processing UserName: ", HOLD
INC total_users
count = 0
FPUTLN 1, "──────────────────────────────────────────────────────────────────────"
FPUT 1, hold + " has "
hold = DGET(0,DNAME(0,2))
IF (DDELETED(0)) THEN
FPUTLN 1, "-* been flagged for Deletion *- "
INC total_users_wofiles
CONTINUE
ELSEIF (DGET(0,DNAME(0,2)) = " ") THEN
FPUTLN 1, "-* NO FILES *- in their database"
INC total_users_wofiles
CONTINUE
ELSE
FPUTLN 1, "these files in their database:"
FPUTLN 1, ""
INC total_users_wfiles
END IF
FOR x = 2 TO 25
IF (DGET(0,DNAME(0,x)) = " ") THEN
FPUTLN 1, ""
FPUTLN 1, ""
BREAK
END IF
INC total_files
INC count
hold = SPACE(2-LEN(STRING(x-1))) + STRING(x-1) + ". " + DGET(0,DNAME(0,x)) + SPACE(2)
FPUT 1, hold
hold = LOWER(DGET(0,DNAME(0,x+24)))
FPUT 1, HOLD + SPACE(1)
IF (count%2 = 0) THEN
FPUTLN 1, ""
count = 0
END IF
NEXT
END WHILE
FPUTLN 1, "──────────────────────────────────────────────────────────────────────"
FPUTLN 1, ""
FPUTLN 1, ""
FPUTLN 1, " ************************************************************"
FPUTLN 1, ""
FPUTLN 1, " 'Tickle File' Statistics Summary Report"
FPUTLN 1, ""
FPUTLN 1, ""
FPUTLN 1, " Total Users in Database : " + STRING(total_users)
FPUTLN 1, " Total Files in Database : " + STRING(total_files)
FPUTLN 1, " Total Users with Files in Database : " + STRING(total_users_wfiles)
FPUTLN 1, " Total Users without Files in Database : " + STRING(total_users_wofiles)
files_per_user = total_files/total_users_wfiles
FPUTLN 1, " Files Per User with Files in Database : " + STRING(files_per_user)
FPUTLN 1, ""
FPUTLN 1, " ************************************************************"
FCLOSE 1
STARTDISP FCL
END
'
' Subroutine to open/create database files
'
:OPEN_DATABASE
IF (!EXIST(PPEPATH()+"tickle.dbf")) THEN
'
' Database structure initialization
'
' 24 fields - Field 1 = Users Name (Up to 25 Characters - PCB Limit)
' Field 2-24 = Filenames (Up to 12 Characters - DOS Limit)
'
dbfields(0) = "usr_name,C,25,0"
dbfields(1) = "file1,C,12,0"
dbfields(2) = "file2,C,12,0"
dbfields(3) = "file3,C,12,0"
dbfields(4) = "file4,C,12,0"
dbfields(5) = "file5,C,12,0"
dbfields(6) = "file6,C,12,0"
dbfields(7) = "file7,C,12,0"
dbfields(8) = "file8,C,12,0"
dbfields(9) = "file9,C,12,0"
dbfields(10) = "file10,C,12,0"
dbfields(11) = "file11,C,12,0"
dbfields(12) = "file12,C,12,0"
dbfields(13) = "file13,C,12,0"
dbfields(14) = "file14,C,12,0"
dbfields(15) = "file15,C,12,0"
dbfields(16) = "file16,C,12,0"
dbfields(17) = "file17,C,12,0"
dbfields(18) = "file18,C,12,0"
dbfields(19) = "file19,C,12,0"
dbfields(20) = "file20,C,12,0"
dbfields(21) = "file21,C,12,0"
dbfields(22) = "file22,C,12,0"
dbfields(23) = "file23,C,12,0"
dbfields(24) = "file24,C,12,0"
dbfields(25) = "desc1,C,15,0"
dbfields(26) = "desc2,C,15,0"
dbfields(27) = "desc3,C,15,0"
dbfields(28) = "desc4,C,15,0"
dbfields(29) = "desc5,C,15,0"
dbfields(30) = "desc6,C,15,0"
dbfields(31) = "desc7,C,15,0"
dbfields(32) = "desc8,C,15,0"
dbfields(33) = "desc9,C,15,0"
dbfields(34) = "desc10,C,15,0"
dbfields(35) = "desc11,C,15,0"
dbfields(36) = "desc12,C,15,0"
dbfields(37) = "desc13,C,15,0"
dbfields(38) = "desc14,C,15,0"
dbfields(39) = "desc15,C,15,0"
dbfields(40) = "desc16,C,15,0"
dbfields(41) = "desc17,C,15,0"
dbfields(42) = "desc18,C,15,0"
dbfields(43) = "desc19,C,15,0"
dbfields(44) = "desc20,C,15,0"
dbfields(45) = "desc21,C,15,0"
dbfields(46) = "desc22,C,15,0"
dbfields(47) = "desc23,C,15,0"
dbfields(48) = "desc24,C,15,0"
DCREATE 0, PPEPATH()+"tickle", FALSE, dbfields
ELSE
DOPEN 0, PPEPATH()+"tickle", FALSE
END IF
RETURN